home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / pibterm / pibt41s2.arc / KREC.MOD < prev    next >
Encoding:
Text File  |  1988-02-21  |  22.2 KB  |  561 lines
  1. (*----------------------------------------------------------------------*)
  2. (*        Do_Keyboard_Checks --- Check keyboard for activity            *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Do_Keyboard_Checks;
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  Do_Keyboard_Checks                                   *)
  10. (*                                                                      *)
  11. (*     Purpose:    Check keyboard for activity                          *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        Do_Keyboard_Checks;                                           *)
  16. (*                                                                      *)
  17. (*     Calls:                                                           *)
  18. (*                                                                      *)
  19. (*        Async_Flush_Output_Buffer                                     *)
  20. (*        Handle_Function_Key                                           *)
  21. (*        Flip_Display_Status                                           *)
  22. (*        Write_To_Status_Line                                          *)
  23. (*        Print_Spooled_File                                            *)
  24. (*        Async_Send                                                    *)
  25. (*                                                                      *)
  26. (*----------------------------------------------------------------------*)
  27.  
  28. VAR
  29.    A_Ch : CHAR;
  30.  
  31. BEGIN (* Do_Keyboard_Checks *)
  32.                                    (* Pick up keyboard entry, if any.     *)
  33.    WHILE PibTerm_KeyPressed DO
  34.       BEGIN
  35.  
  36.          Read_Kbd( A_Ch );
  37.                                    (* If shift-tab, toggle transfer display *)
  38.  
  39.          IF ( ORD( A_Ch ) = ESC ) THEN
  40.             IF PibTerm_KeyPressed THEN
  41.                BEGIN
  42.  
  43.                   Read_Kbd( A_Ch );
  44.  
  45.                   IF ( ( ORD( A_Ch ) = ALT_R ) AND ( NOT Sending_File ) ) OR
  46.                      ( ( ORD( A_Ch ) = ALT_S ) AND (     Sending_File ) ) THEN
  47.                      A_Ch := ^K
  48.                   ELSE IF ( ORD( A_Ch ) = Shift_Tab ) THEN
  49.                      BEGIN
  50.                         Flip_Display_Status;
  51.                         A_Ch := CHR( 0 );
  52.                      END
  53.                   ELSE
  54.                      Handle_Function_Key( A_Ch );
  55.  
  56.                END
  57.             ELSE
  58.                IF Async_XOff_Received THEN
  59.                   BEGIN
  60.                      IF ( NOT Kermit_Do_Sliding_Win ) THEN
  61.                         Async_Flush_Output_Buffer;
  62.                      Clear_XOFF_Received;
  63.                   END;
  64.  
  65.          CASE A_Ch OF
  66.  
  67.             ^B:  BEGIN    (* Cancel current batch of files *)
  68.                     Kermit_Abort       := TRUE;
  69.                     Kermit_Abort_Level := All_Files;
  70.                  END;
  71.  
  72.             ^F:  BEGIN    (* Cancel current file *)
  73.                     Kermit_Abort       := TRUE;
  74.                     Kermit_Abort_Level := One_File;
  75.                  END;
  76.  
  77.             ^K:  BEGIN    (* Drop out of Kermit entirely *)
  78.                     Kermit_Abort       := TRUE;
  79.                     Kermit_Abort_Level := Entire_Protocol;
  80.                  END;
  81.  
  82.             ^M,
  83.             ^R:  BEGIN    (* Retry current packet *)
  84.                     Kermit_Retry       := TRUE;
  85.                     Async_Send( CHR( CR ) );
  86.                  END;
  87.  
  88.             ELSE;
  89.  
  90.          END (* CASE *);
  91.  
  92.       END;
  93.                                    (* Print character from spooled file *)
  94.    IF Print_Spooling THEN
  95.       Print_Spooled_File;
  96.                                    (* If carrier dropped, quit *)
  97.  
  98.    IF ( NOT Async_Carrier_Detect ) THEN
  99.       BEGIN
  100.          Kermit_Abort       := TRUE;
  101.          Kermit_Abort_Level := Entire_Protocol;
  102.       END;
  103.  
  104. END   (* Do_Keyboard_Checks *);
  105.  
  106. (*----------------------------------------------------------------------*)
  107. (*             Get_Char --- Get character for Kermit packet             *)
  108. (*----------------------------------------------------------------------*)
  109.  
  110. PROCEDURE Get_Char( VAR Ch : INTEGER );
  111.  
  112. (*----------------------------------------------------------------------*)
  113. (*                                                                      *)
  114. (*     Procedure:  Get_Char                                             *)
  115. (*                                                                      *)
  116. (*     Purpose:    Gets character for Kermit packet                     *)
  117. (*                                                                      *)
  118. (*     Calling Sequence:                                                *)
  119. (*                                                                      *)
  120. (*        Get_Char( VAR Ch: INTEGER );                                  *)
  121. (*                                                                      *)
  122. (*           Ch --- returned character                                  *)
  123. (*                                                                      *)
  124. (*     Calls:                                                           *)
  125. (*                                                                      *)
  126. (*        Async_Receive_With_TimeOut                                    *)
  127. (*        Async_Flush_Output_Buffer                                     *)
  128. (*        Handle_Function_Key                                           *)
  129. (*        Flip_Display_Status                                           *)
  130. (*        Write_To_Status_Line                                          *)
  131. (*        Print_Spooled_File                                            *)
  132. (*        Async_Send                                                    *)
  133. (*                                                                      *)
  134. (*----------------------------------------------------------------------*)
  135.  
  136. VAR
  137.    Temp          : INTEGER;
  138.    Rec_Stat_Flag : BOOLEAN;
  139.    A_Ch          : CHAR;
  140.    ITimer        : INTEGER;
  141.  
  142. BEGIN (* Get_Char *)
  143.  
  144.    Temp               := 0;
  145.    Kermit_Abort       := FALSE;
  146.    Kermit_Retry       := FALSE;
  147.    Rec_Stat_Flag      := FALSE;
  148.    Kermit_Abort_Level := No_Abort;
  149.  
  150.                                    (* Do fast check for character *)
  151.                                    (* available before doing long *)
  152.                                    (* check.                      *)
  153.  
  154.    IF ( Async_Buffer_Head <> Async_Buffer_Tail ) THEN
  155.       BEGIN
  156.          Rec_Stat_Flag := Async_Receive( A_Ch );
  157.          Ch            := ORD( A_Ch );
  158.          EXIT;
  159.       END;
  160.                                    (* Loop until char found from *)
  161.                                    (* comm port or keyboard      *)
  162.    REPEAT
  163.                                    (* Pick up a character from comm port, *)
  164.                                    (* if any.                             *)
  165.       ITimer := 0;
  166.                                    (* Break up timeout into 1-sec pieces  *)
  167.       REPEAT
  168.                                    (* Pick up a character                 *)
  169.          INC( ITimer );
  170.  
  171.          Async_Receive_With_TimeOut( 1 , Ch );
  172.  
  173.                                    (* If we timed out, indicate retry *)
  174.                                    (* should be done.                 *)
  175.          IF ( Ch = TimeOut ) THEN
  176.             BEGIN
  177.                Kermit_Retry  := ( ITimer > His_TimeOut );
  178.                Rec_Stat_Flag := FALSE;
  179.                Ch            := 0;
  180.             END
  181.          ELSE
  182.             Rec_Stat_Flag := TRUE;
  183.  
  184.       UNTIL( Rec_Stat_Flag OR Kermit_Retry );
  185.  
  186.    UNTIL ( Rec_Stat_Flag OR Kermit_Abort OR Kermit_Retry );
  187.  
  188.                                    (* Make sure to check for carrier *)
  189.                                    (* drop if we timed out.          *)
  190.    IF Kermit_Retry THEN
  191.       Do_Keyboard_Checks;
  192.  
  193. END   (* Get_Char *);
  194.  
  195. (*----------------------------------------------------------------------*)
  196. (*                Receive_Packet --- Receive Kermit packet              *)
  197. (*----------------------------------------------------------------------*)
  198.  
  199. PROCEDURE Receive_Packet;
  200.  
  201. (*----------------------------------------------------------------------*)
  202. (*                                                                      *)
  203. (*     Procedure:  Receive_Packet                                       *)
  204. (*                                                                      *)
  205. (*     Purpose:    Gets Kermit packet                                   *)
  206. (*                                                                      *)
  207. (*     Calling Sequence:                                                *)
  208. (*                                                                      *)
  209. (*        Receive_Packet;                                               *)
  210. (*                                                                      *)
  211. (*     Calls:                                                           *)
  212. (*                                                                      *)
  213. (*        Get_Char                                                      *)
  214. (*        Get_P_Length                                                  *)
  215. (*        Kermit_Chk8                                                   *)
  216. (*        Kermit_Chk12                                                  *)
  217. (*        Kermit_CRC                                                    *)
  218. (*                                                                      *)
  219. (*     Remarks:                                                         *)
  220. (*                                                                      *)
  221. (*        A Kermit packet starts with an SOH character, followed by a   *)
  222. (*        packet length, then the block number MOD 64, then the packet  *)
  223. (*        data, and finally a checksum or crc.                          *)
  224. (*                                                                      *)
  225. (*----------------------------------------------------------------------*)
  226.  
  227. VAR
  228.    Rec_Char          : INTEGER;
  229.    B_Rec_Char        : BYTE;
  230.    Temp              : INTEGER;
  231.    Check_Char        : CHAR;
  232.    Check_OK          : BOOLEAN;
  233.    CheckSum          : INTEGER;
  234.    Count             : INTEGER;
  235.    Index             : INTEGER;
  236.    StrNum            : STRING[3];
  237.    Chk1              : CHAR;
  238.    Chk2              : CHAR;
  239.    Chk3              : CHAR;
  240.    Check_Type        : INTEGER;
  241.    L_Packet          : INTEGER;
  242.    Rec_Pos           : INTEGER;
  243.    Echoed_Packet     : BOOLEAN;
  244.    Long_Packet       : BOOLEAN;
  245.    Long_Packet_Found : BOOLEAN;
  246.    Packet_For_Debug  : AnyStr;
  247.  
  248. (*----------------------------------------------------------------------*)
  249. (*             Get_P_Length --- Get length of Kermit packet             *)
  250. (*----------------------------------------------------------------------*)
  251.  
  252. FUNCTION Get_P_Length : BOOLEAN;
  253.  
  254. BEGIN (* Get_P_Length *)
  255.  
  256.    Get_P_Length      := TRUE;
  257.    Long_Packet       := FALSE;
  258.    Long_Packet_Found := FALSE;
  259.    L_Packet          := 0;
  260.                                    (* If next char is not SOH, it must *)
  261.                                    (* be length.  If 0, then this is a *)
  262.                                    (* long packet.                     *)
  263.  
  264.    IF NOT ( Kermit_Abort OR Kermit_Retry ) THEN
  265.       BEGIN
  266.          Get_Char( Rec_Char );
  267.          IF ( Rec_Char = ORD( Kermit_Header_Char ) ) THEN
  268.             BEGIN
  269.                Get_P_Length := FALSE;
  270.                Count        := 2000;
  271.             END
  272.          ELSE
  273.             BEGIN
  274.                                    (* Get packet length *)
  275.  
  276.                Count    := Rec_Char - 32;
  277.                L_Packet := Count;
  278.  
  279.                                    (* If length is zero, prepare to   *)
  280.                                    (* process long (>94 chars) packet *)
  281.  
  282.                IF ( Count = 0 ) THEN
  283.                   BEGIN
  284.                      Long_Packet       := TRUE;
  285.                      Long_Packet_Found := TRUE;
  286.                      Count             := 5;
  287.                   END;
  288.  
  289.             END
  290.       END
  291.    ELSE
  292.       Count := 0;
  293.  
  294.    Do_Keyboard_Checks;
  295.  
  296. END (* Get_P_Length *);
  297.  
  298. (*----------------------------------------------------------------------*)
  299. (*                Get_The_Packet --- Get Kermit packet                  *)
  300. (*----------------------------------------------------------------------*)
  301.  
  302. PROCEDURE Get_The_Packet;
  303.  
  304. VAR
  305.    I: INTEGER;
  306.  
  307. BEGIN (* Get_The_Packet *)
  308.                                    (* Wait for header character (SOH).  *)
  309.                                    (* If autodownload, then SOH already *)
  310.                                    (* found.                            *)
  311.    IF Initial_SOH_Received THEN
  312.       BEGIN
  313.          Kermit_Abort         := FALSE;
  314.          Kermit_Retry         := FALSE;
  315.          Kermit_Abort_Level   := No_Abort;
  316.          Rec_Char             := ORD( SOH );
  317.       END
  318.    ELSE
  319.       REPEAT  (* get header character *)
  320.          Get_Char( Rec_Char );
  321.          Do_Keyboard_Checks;
  322.       UNTIL ( ( Rec_Char = ORD( Kermit_Header_Char ) ) OR
  323.                Kermit_Abort OR Kermit_Retry );
  324.  
  325.                                    (* Initialize packet *)
  326.  
  327.    Initial_SOH_Received := FALSE;
  328.    Rec_Packet_Ptr       := ADDR( Sector_Data );
  329.    Rec_Pos              := 1;
  330.    Check_OK             := FALSE;
  331.    Packet_OK            := FALSE;
  332.    Echoed_Packet        := FALSE;
  333.    Check_Type           := ORD( His_Chk_Type ) - ORD('0');
  334.    CheckSum             := 0;
  335.    Kermit_Packet_Type   := Unknown;
  336.  
  337.                                    (* Get packet length *)
  338.    WHILE ( NOT Get_P_Length ) DO
  339.       Rec_Pos := 1;
  340.                                    (* Get rest of packet *)
  341.  
  342.    IF NOT ( Kermit_Abort OR Kermit_Retry ) THEN
  343.       BEGIN (* NOT ( Abort OR Retry ) *)
  344.          REPEAT
  345.                                    (* Packet type and data *)
  346.             Get_Char( Rec_Char );
  347.  
  348.             IF ( Rec_Char = ORD( Kermit_Header_Char ) ) THEN
  349.                BEGIN  (* got new start of packet *)
  350.  
  351.                                    (* Packet is initially empty *)
  352.                   REPEAT
  353.                      Rec_Pos        := 1;
  354.  
  355.                   UNTIL Get_P_Length OR Kermit_Abort OR Kermit_Retry;
  356.  
  357.                END
  358.             ELSE  (* must be a character *)
  359.                BEGIN
  360.                   INC( Rec_Pos );
  361.                   Rec_Packet_Ptr^[Rec_Pos] := CHR( Rec_Char );
  362.                   DEC( Count );
  363.                END;
  364.  
  365.                                    (* If long packet and count is 0, *)
  366.                                    (* process extended length and    *)
  367.                                    (* keep on going.                 *)
  368.  
  369.             IF ( ( Count = 0 ) AND Long_Packet ) THEN
  370.                BEGIN
  371.  
  372.                   CheckSum := 32 + ORD( Rec_Packet_Ptr^[2] ) +
  373.                                    ORD( Rec_Packet_Ptr^[3] ) +
  374.                                    ORD( Rec_Packet_Ptr^[4] ) +
  375.                                    ORD( Rec_Packet_Ptr^[5] );
  376.  
  377.                   CheckSum := ( ( CheckSum + ( ( CheckSum AND 192 ) SHR 6 ) ) AND 63 );
  378.  
  379.                   Chk1     := CHR( CheckSum + 32 );
  380.  
  381.                   Check_OK := ( Chk1 = Rec_Packet_Ptr^[ 6 ] );
  382.  
  383.                                    (* If checksum on lengths bad,        *)
  384.                                    (* set up to flush packet and return, *)
  385.                                    (* else get extended length.          *)
  386.  
  387.                   IF ( NOT Check_OK ) THEN
  388.                      BEGIN
  389.                         Packet_OK          := FALSE;
  390.                         Packets_Received   := Packets_Received + 1;
  391.                         Update_Kermit_Display;
  392.                         Kermit_Packet_Type := Unknown;
  393.                         EXIT;
  394.                      END
  395.                   ELSE
  396.                      BEGIN
  397.                         Count       := 95 * ( ORD( Rec_Packet_Ptr^[4] ) - 32 ) +
  398.                                             ( ORD( Rec_Packet_Ptr^[5] ) - 32 );
  399.                         Long_Packet := FALSE;
  400.                      END;
  401.  
  402.                END;
  403.  
  404.          UNTIL ( Kermit_Abort    OR
  405.                  Kermit_Retry    OR
  406.                  ( ( Count = 0 ) AND ( NOT Long_Packet ) ) );
  407.  
  408.                                    (* Check for keyboard input *)
  409.       Do_Keyboard_Checks;
  410.                                    (* Store length of packet  *)
  411.  
  412.       Rec_Packet_Length  := Rec_Pos;
  413.       Rec_Packet_Ptr^[1] := CHR( L_Packet + 32 );
  414.  
  415.                                    (* Check if this looks like an *)
  416.                                    (* echoed packet               *)
  417.  
  418.       IF ( ( Rec_Packet_Ptr^[2] = Send_Packet_Ptr^[3] ) AND
  419.            ( Rec_Packet_Ptr^[3] = Send_Packet_Ptr^[4] ) ) THEN
  420.          BEGIN
  421.             Echoed_Packet := TRUE;
  422.             EXIT;
  423.          END;
  424.                                    (* Update packets received *)
  425.  
  426.       Packets_Received := Packets_Received + 1;
  427.  
  428.                                    (* Update display *)
  429.       Update_Kermit_Display;
  430.  
  431.       IF ( NOT Kermit_Abort ) THEN
  432.          BEGIN  (* NOT Abort *)
  433.                                    (* Compute and check checksum or crc *)
  434.  
  435.             CASE His_Chk_Type OF
  436.  
  437.                '1': BEGIN
  438.  
  439.                        Kermit_Chk8( Rec_Packet_Ptr^,
  440.                                     Rec_Packet_Length - 1,
  441.                                     CheckSum );
  442.  
  443.                        CheckSum := ( ( CheckSum + ( ( CheckSum AND 192 ) SHR 6 ) ) AND 63 );
  444.  
  445.                        Chk1     := CHR( CheckSum + 32 );
  446.  
  447.                        Check_OK := ( Chk1 = Rec_Packet_Ptr^[ Rec_Packet_Length ] );
  448.  
  449.                     END;
  450.  
  451.                '2': BEGIN
  452.  
  453.                        Kermit_Chk12( Rec_Packet_Ptr^,
  454.                                      Rec_Packet_Length - 2,
  455.                                      CheckSum );
  456.  
  457.                        Chk1 := CHR( CheckSum SHR 6  + 32 );
  458.                        Chk2 := CHR( CheckSum AND 63 + 32 );
  459.  
  460.                        Check_OK := ( Chk1 = Rec_Packet_Ptr^[ Rec_Packet_Length - 1 ] ) AND
  461.                                    ( Chk2 = Rec_Packet_Ptr^[ Rec_Packet_Length     ] );
  462.  
  463.                    END;
  464.  
  465.               '3': BEGIN
  466.  
  467.                       Kermit_CRC( Rec_Packet_Ptr^,
  468.                                   Rec_Packet_Length - 3,
  469.                                   CheckSum );
  470.  
  471.                       Chk1 := CHR( ( CheckSum SHR 12 ) AND 63  + 32 );
  472.                       Chk2 := CHR( ( CheckSum SHR 6  ) AND 63  + 32 );
  473.                       Chk3 := CHR( CheckSum AND 63             + 32 );
  474.  
  475.                       Check_OK := ( Chk1 = Rec_Packet_Ptr^[ Rec_Packet_Length - 2 ] ) AND
  476.                                   ( Chk2 = Rec_Packet_Ptr^[ Rec_Packet_Length - 1 ] ) AND
  477.                                   ( Chk3 = Rec_Packet_Ptr^[ Rec_Packet_Length     ] );
  478.  
  479.                   END;
  480.  
  481.             END (* CASE *);
  482.                                    (* Get packet number *)
  483.  
  484.             Rec_Packet_Num := ORD( Rec_Packet_Ptr^[2] ) - 32;
  485.  
  486.                                    (* Set next state based upon packet type *)
  487.  
  488.             CASE Rec_Packet_Ptr^[3] OF
  489.                'A' : Kermit_Packet_Type := Attrib_Pack;
  490.                'B' : Kermit_Packet_Type := Break_Pack;
  491.                'D' : Kermit_Packet_Type := Data_Pack;
  492.                'E' : Kermit_Packet_Type := Error_Pack;
  493.                'F' : Kermit_Packet_Type := Header_Pack;
  494.                'G' : Kermit_Packet_Type := Generic_Pack;
  495.                'H' : Kermit_Packet_Type := Host_Pack;
  496.                'N' : Kermit_Packet_Type := NAK_Pack;
  497.                'S' : Kermit_Packet_Type := Send_Pack;
  498.                'T' : Kermit_Packet_Type := Reserved_Pack;
  499.                'X' : Kermit_Packet_Type := Text_Pack;
  500.                'Y' : Kermit_Packet_Type := ACK_Pack;
  501.                'Z' : Kermit_Packet_Type := End_Pack;
  502.                ELSE  Kermit_Packet_Type := Unknown;
  503.             END (* CASE *);
  504.                                    (* Strip type, #, checksum from packet *)
  505.  
  506.             IF Long_Packet_Found THEN
  507.                Index := 6
  508.             ELSE
  509.                Index := 3;
  510.  
  511.             IF ( Rec_Packet_Length > ( Check_Type + Index ) ) THEN
  512.                BEGIN
  513.                   Rec_Packet_Ptr    := ADDR( Rec_Packet_Ptr^[Index + 1] );
  514.                   Rec_Packet_Length := Rec_Packet_Length - Check_Type - Index;
  515.                END;
  516.                                     (* Set flag if packet OK *)
  517.  
  518.             IF ( Check_OK AND ( Kermit_Packet_Type <> Unknown ) ) THEN
  519.                Packet_OK := TRUE;
  520.  
  521.          END  (* NOT Abort *);
  522.  
  523.       END  (* NOT ( Abort OR Retry ) *);
  524. {
  525.    IF Kermit_Debug THEN
  526.       BEGIN
  527.          Packet_For_Debug := '<';
  528.          MOVE( Rec_Packet_Ptr^[1], Packet_For_Debug[2], Rec_Packet_Length );
  529.          Packet_For_Debug[0] := CHR( Rec_Packet_Length + 1 );
  530.          Packet_For_Debug := Packet_For_Debug + '>';
  531.          Write_Log( '----- Get_The_Packet -----', FALSE, FALSE );
  532.          Write_Log( Packet_For_Debug, TRUE, FALSE );
  533.          Write_Log( 'Rec_Packet_Length = ' + IToS( Rec_Packet_Length ), TRUE, FALSE );
  534.          Write_Log( 'Rec_Packet_Number = ' + IToS( Rec_Packet_Num    ), TRUE, FALSE );
  535.          IF Echoed_Packet THEN
  536.             Write_Log( 'Echoed packet', TRUE, FALSE )
  537.          ELSE
  538.             Write_Log( 'Not echoed packet', TRUE, FALSE );
  539.          IF Kermit_Retry THEN
  540.             Write_Log( 'Retry set', TRUE, FALSE )
  541.          ELSE
  542.             Write_Log( 'Retry not set', TRUE, FALSE );
  543.          Write_Log( '------------------', FALSE, FALSE );
  544.       END;
  545. }
  546.  
  547. END   (* Get_The_Packet *);
  548.  
  549. (*----------------------------------------------------------------------*)
  550.  
  551. BEGIN (* Receive_Packet *)
  552.                                    (* Get a packet *)
  553.    Get_The_Packet;
  554.                                    (* If this appears to be an echoed *)
  555.                                    (* packet, try again.              *)
  556.  
  557.    IF Echoed_Packet AND ( NOT Kermit_Abort OR Kermit_Retry ) THEN
  558.       Get_The_Packet;
  559.  
  560. END   (* Receive_Packet *);
  561.